home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / Yerk 3.64 / Toolbox Classes / pictures < prev    next >
Text File  |  1993-05-14  |  2KB  |  59 lines
  1. \ 2.1.87    rfl version
  2. \ 4.28.88    rfl moveto needs work
  3. \ 8.31.88    rfl added theClip to this source
  4. \ 8.14.90    rfl moveto fixed
  5. \ 4.11.92    rfl    added putResId: as alias for init:
  6. \ 5.13.93    rfl protected getnew:
  7.  
  8. rect theClip    \ global clip rectangle
  9. -1000 dup 1000 dup put: theClip
  10.  
  11. : +pair { x1 y1 x2 y2 -- x1+y1 x2+y2 } x1 x2 + y1 y2 + ;
  12.  
  13. \ Interface object for QD picture support
  14. :CLASS Picture  <Super Object
  15.  
  16.     Handle    picHndl
  17.     Int        resID        \ resource ID if it is a resource
  18.     Rect    DestRect    \ destination rectangle for drawing
  19.  
  20.     \ ( l t r b -- )  Open a new pict with given frame
  21.     :M  OPEN:  Put: destrect  0 abs: destrect call OpenPicture
  22.         Put: picHndl  ;M
  23.  
  24.     \ ( -- )  terminate this picture definition
  25.     :M  CLOSE:  call ClosePicture   ;M
  26.  
  27.     \ ( resID -- )
  28.     :M INIT:  put:  resID  ;M
  29.  
  30.     :M PUTRESID: put: resID ;M
  31.  
  32.     \ load the picture from a resource file
  33.     :M  GETNEW:  0 int: resID  call GetPicture dup 0= classerr" 170 put: picHndl
  34.         ptr: picHndl  2+ get: rect  put: destRect   ;M
  35.  
  36.     \ ( w h -- )  Set size in pixels of dest rect
  37.     :M  SIZE:   getTop:  destRect  +Pair  putBot: destRect ;M
  38.  
  39.     \ ( x y -- )  Move dest rect to given location
  40.     :M  GOTO:  { x y -- }   Size: destRect  x y putTop: DestRect
  41.         Size: self  ;M
  42.  
  43.     \ ( -- )  Draw the picture in destRect
  44.     :M  DRAW:  get: picHndl abs: destRect
  45.         call DrawPicture   ;M
  46.  
  47.     \ ( x y resID -- )  Combines the actions of init:, getNew:, goto: & draw:
  48.     :M  DISP:  putResID: self  getNew: self  goto: self  draw: self  ;M
  49.  
  50.     \ goto to location and draw self
  51.     :M  MOVETO: ( x y -- ) goto: self draw: self ;M
  52.  
  53.     \ ( -- )  dispose of picture heap
  54.     :M  KILL:  get: picHndl  call KillPicture   ;M
  55.  
  56. ;CLASS
  57.  
  58.  
  59.